unit uDZList;

interface

uses
  SysUtils, RTLConsts, uDZTypes, uDZConsts, uDZSysUtils,
  uDZContnrs, uDZPersistent;

const
  LIST_ALLOW_DUPLICATE = $00000001;
  LIST_ORDERED = $00000002;
  
type
  EdzListError = class(Exception);

  TOrderedList = class(TPersistent, IList, IDictionary)
  private
    FKeySize: Integer;
    FValueSize: Integer;
    FItems: Pointer;
    FSize: Integer;
    FCapacity: Integer;
    FOption: TUnsignedLong;
  private
    ItemSize: Integer;
    procedure QuickSort(l: Integer; r: Integer);
  protected
    { IContainer }
    function GetSize: Int64;
    procedure SetSize(const Value: Int64);
    function GetCapacity: Int64;
    procedure SetCapacity(const Value: Int64);
    procedure Clear;
    { IList }
    function GetOrdered: Boolean;
    procedure SetOrdered(value: Boolean);
    function GetAllowDuplicate: Boolean;
    procedure SetAllowDuplicate(value: Boolean);
    procedure List_Erase(index: Integer);
    function _GetKey(index: Integer): Pointer;
    procedure _SetKey(index: Integer; key: Pointer);
    function _GetValue(index: Integer): Pointer;
    procedure _SetValue(index: Integer; value: Pointer);
    procedure List_SetItem(index: Integer; key, value: Pointer);
    function _IndexOf(key: Pointer): Integer;
    function List_Insert(key, value: Pointer): Integer;
    procedure _InsertAt(index: Integer; key, value: Pointer);
    procedure IList._SetItem = List_SetItem;
    function IList._Insert = List_Insert;
    procedure IList._Erase = List_Erase;
    { IDictionary }
    function GetConflict: Int64;
    function GetKeySize: Integer;
    function GetValueSize: Integer;
    procedure Dictionary_SetItem(key: Pointer; value: Pointer);
    function Dictionary_GetItem(key: Pointer): Pointer;
    function _Find(key: Pointer; value: PPointer): Boolean;
    function Dictionary_Erase(key: Pointer): Boolean;
    function Dictionary_Insert(key: Pointer; value: Pointer;
      internal: PPointer; replaceIfExists: Boolean): Boolean;
    function GetFirstPair: Pointer;
    function GetLastPair: Pointer;
    function Succeed(pair: Pointer): Pointer;
    function Precede(pair: Pointer): Pointer;
    function GetPairKey(pair: Pointer): Pointer;
    function GetPairValue(pair: Pointer): Pointer;
    procedure SetPairValue(pair: Pointer; value: Pointer);
    function _Delete(pair: Pointer): Pointer;
    procedure Copy(const src: IDictionary);
    function IDictionary._GetItem = Dictionary_GetItem;
    procedure IDictionary._SetItem = Dictionary_SetItem;
    function IDictionary._Insert = Dictionary_Insert;
    function IDictionary._Erase = Dictionary_Erase;

  protected
    { called by child class }
    constructor Create(_keySize: Integer;
      _valueSize: Integer); reintroduce; overload;
    procedure Grow;
    function GetIterator: IIterator; virtual; abstract;
    procedure CleanupKey(item: Pointer); dynamic;
    procedure CleanupValue(value: Pointer); dynamic;
    procedure InitKey(key: Pointer); virtual;
    procedure InitValue(value: Pointer); virtual;
    procedure AssignKey(src: Pointer; dest: Pointer); virtual;
    procedure AssignValue(src: Pointer; dest: Pointer); virtual;
    procedure ExchangeKey(src: Pointer; dest: Pointer); virtual;
    procedure ExchangeValue(src: Pointer; dest: Pointer); virtual;
    function CompareKey(key1: Pointer; key2: Pointer): TCompareResult; dynamic;
  public
    destructor Destroy; override;
    class procedure Error(const Msg: string; Data: Integer); overload;
    class procedure Error(Msg: PResStringRec; Data: Integer); overload;
  end;

  TComparePointerProc = function(p1, p2: Pointer): TCompareResult;

  TOrderedPointerList = class(TOrderedList, IPointerList)
  private
    FCompare: TComparePointerProc;
  protected
    function GetIterator: IIterator; override;
    procedure ExchangeKey(key1: Pointer; key2: Pointer); override;
    procedure AssignKey(src: Pointer; dest: Pointer); override;
    function CompareKey(key1: Pointer; key2: Pointer): TCompareResult; override;
    // IPointerList 
    procedure PushFront(item: Pointer);
    procedure PushBack(item: Pointer);
    function PopFront: Pointer;
    function PopBack: Pointer;
    function IndexOf(item: Pointer): Integer;
    procedure InsertAt(index: Integer; item: Pointer);
    function GetItem(index: Integer): Pointer;
    procedure SetItem(index: Integer; item: Pointer);
    procedure IPointerList._SetItem = List_SetItem;
    function IPointerList._Insert = List_Insert;
    procedure IPointerList._Erase = List_Erase;
  public
    constructor Create(_compare: TComparePointerProc); overload;
  end;

  TAnsiStringList = class(TOrderedList, IAnsiStringList,
                            IAnsiStrDictionary)
  private
    FCaseSensitive: Boolean;
    FObjectStored: Boolean;
    //IAnsiStrDictionary 
    function AnsiStrDictionary_GetItem(const key: AnsiString): Pointer;
    procedure AnsiStrDictionary_SetItem(const key: AnsiString; value: Pointer);
    function Find(const key: AnsiString; value: PPointer): Boolean;
    function Find2(key: PAnsiChar; len: Integer; data: PPointer): Boolean;
    function Erase(const key: AnsiString): Boolean;
    function Insert(const key: AnsiString; value: Pointer;
      internal: PPointer; replaceIfExists: Boolean): Boolean;
  protected
    function GetIterator: IIterator; override;
    procedure InitKey(key: Pointer); override;
    procedure AssignKey(src, dest: Pointer); override;
    procedure AssignValue(src, dest: Pointer); override;
    procedure CleanupKey(key: Pointer); override;
    function CompareKey(key1, key2: Pointer): TCompareResult; override;
    procedure ExchangeKey(src, dest: Pointer); override;
    procedure ExchangeValue(src: Pointer; dest: Pointer); override;
    //IAnsiStringList
    procedure PushFront(value: AnsiString);
    procedure PushBack(value: AnsiString);
    function PopFront: AnsiString;
    function PopBack: AnsiString;
    function IndexOf(item: AnsiString): Integer;
    procedure InsertAt(index: Integer; value: AnsiString);
    function AnsiStringList_GetItem(index: Integer): AnsiString;
    procedure AnsiStringList_SetItem(index: Integer; str: AnsiString);
    function GetObjectByIndex(index: Integer): Pointer;
    procedure SetObjectByIndex(index: Integer; obj: Pointer);
    function GetObjectOfStr(str: AnsiString): Pointer;
    procedure SetObjectOfStr(str: AnsiString; obj: Pointer);
    procedure PushObjectFront(str: AnsiString; obj: Pointer);
    procedure PushObjectBack(str: AnsiString; obj: Pointer);
    function PopObjectFront: Pointer;
    function PopObjectBack: Pointer;
    procedure InsertObjectAt(index: Integer; str: AnsiString; obj: Pointer);
    procedure IAnsiStringList._SetItem = List_SetItem;
    function IAnsiStringList._Insert = List_Insert;
    procedure IAnsiStringList._Erase = List_Erase;
    function IAnsiStringList.GetItem = AnsiStringList_GetItem;
    procedure IAnsiStringList.SetItem = AnsiStringList_SetItem;
    //IAnsiStrDictionary
    function IAnsiStrDictionary._GetItem = Dictionary_GetItem;
    procedure IAnsiStrDictionary._SetItem = Dictionary_SetItem;
    function IAnsiStrDictionary._Insert = Dictionary_Insert;
    function IAnsiStrDictionary._Erase = Dictionary_Erase;
    function IAnsiStrDictionary.GetItem = AnsiStrDictionary_GetItem;
    procedure IAnsiStrDictionary.SetItem = AnsiStrDictionary_SetItem;
    //IAnsiStringList & IAnsiStrDictionary 
    function GetCaseSensitive: Boolean;
    procedure SetCaseSensitive(value: Boolean);

  public
    constructor Create(_storeObject: Boolean); overload;
    constructor Create; overload; override;
    property ObjectStored: Boolean read FObjectStored;
  end;

  TAnsiStringListIterator = class(TListIterator,
                                    IAnsiStringListIterator,
                                    IAnsiStrDictionaryIterator)
  public
    //IDictionaryIterator *)
    function _GetKey: Pointer;
    function _GetValue: Pointer;
    procedure _SetValue(value: Pointer);
    //IAnsiStringListIterator
    procedure SetKey(key: AnsiString);
    //IAnsiStringListIterator & IAnsiStrDictionaryIterator
    function GetKey: AnsiString;
    function GetValue: Pointer;
    procedure SetValue(value: Pointer);
  end;

  TWideStringList = class(TOrderedList, IWideStringList,
                            IWideStrDictionary)
  private
    FCaseSensitive: Boolean;
    FObjectStored: Boolean;
    //IWideStrDictionary 
    function WideStrDictionary_GetItem(const key: WideString): Pointer;
    procedure WideStrDictionary_SetItem(const key: WideString; value: Pointer);
    function Find(const key: WideString; value: PPointer): Boolean;
    function Find2(key: PWideChar; len: Integer; data: PPointer): Boolean;
    function Erase(const key: WideString): Boolean;
    function Insert(const key: WideString; value: Pointer;
      internal: PPointer; replaceIfExists: Boolean): Boolean;
  protected
    function GetIterator: IIterator; override;
    procedure InitKey(key: Pointer); override;
    procedure AssignKey(src: Pointer; dest: Pointer); override;
    procedure AssignValue(src: Pointer; dest: Pointer); override;
    procedure CleanupKey(key: Pointer); override;
    function CompareKey(key1: Pointer; key2: Pointer): TCompareResult; override;
    procedure ExchangeKey(src: Pointer; dest: Pointer); override;
    procedure ExchangeValue(src: Pointer; dest: Pointer); override;
    //IWideStringList 
    procedure PushFront(value: WideString);
    procedure PushBack(value: WideString);
    function PopFront: WideString;
    function PopBack: WideString;
    function IndexOf(item: WideString): Integer;
    procedure InsertAt(index: Integer; value: WideString);
    function WideStringList_GetItem(index: Integer): WideString;
    procedure WideStringList_SetItem(index: Integer; str: WideString);
    function GetObjectByIndex(index: Integer): Pointer;
    procedure SetObjectByIndex(index: Integer; obj: Pointer);
    function GetObjectOfStr(str: WideString): Pointer;
    procedure SetObjectOfStr(str: WideString; obj: Pointer);
    procedure PushObjectFront(str: WideString; obj: Pointer);
    procedure PushObjectBack(str: WideString; obj: Pointer);
    function PopObjectFront: Pointer;
    function PopObjectBack: Pointer;
    procedure InsertObjectAt(index: Integer; str: WideString; obj: Pointer);
    procedure IWideStringList._SetItem = List_SetItem;
    function IWideStringList._Insert = List_Insert;
    procedure IWideStringList._Erase = List_Erase;
    function IWideStringList.GetItem = WideStringList_GetItem;
    procedure IWideStringList.SetItem = WideStringList_SetItem;
    //IWideStrDictionary
    function IWideStrDictionary._GetItem = Dictionary_GetItem;
    procedure IWideStrDictionary._SetItem = Dictionary_SetItem;
    function IWideStrDictionary._Insert = Dictionary_Insert;
    function IWideStrDictionary._Erase = Dictionary_Erase;
    function IWideStrDictionary.GetItem = WideStrDictionary_GetItem;
    procedure IWideStrDictionary.SetItem = WideStrDictionary_SetItem;
    //IWideStringList & IWideStrDictionary 
    function GetCaseSensitive: Boolean;
    procedure SetCaseSensitive(value: Boolean);
  public
    constructor Create(_storeObject: Boolean); overload;
    constructor Create; overload; override;
    property ObjectStored: Boolean read FObjectStored;
  end;

  TWideStringListIterator = class(TListIterator,
                                    IWideStringListIterator,
                                    IWideStrDictionaryIterator)
  public
    //IDictionaryIterator
    function _GetKey: Pointer;
    function _GetValue: Pointer;
    procedure _SetValue(value: Pointer);

    //IWideStringListIterator
    procedure SetKey(key: WideString);

    //IWideStringListIterator & IWideStrDictionaryIterator
    function GetKey: WideString;
    function GetValue: Pointer;
    procedure SetValue(value: Pointer);
  end;

type
{$IFDEF UNICODE}
  TStringList = TWideStringList;
  TStringListIterator = TWideStringListIterator;
{$ELSE}
  TStringList = TAnsiStringList;
  TStringListIterator = TAnsiStringListIterator;
{$ENDIF}

function dzComparePointer(p1: Pointer; p2: Pointer): TCompareResult;

implementation

function dzComparePointer(p1: Pointer; p2: Pointer): TCompareResult;
begin
  if (TUnsignedLong(p1) > TUnsignedLong(p2)) then
    Result := crGreater
  else if (TUnsignedLong(p1) = TUnsignedLong(p2)) then
    Result := crEqual
  else
    Result := crLess;
end;

{ TOrderedList }

procedure TOrderedList.AssignKey(src, dest: Pointer);
begin
  Move(src^, dest^, FKeySize);
end;

procedure TOrderedList.AssignValue(src, dest: Pointer);
begin
  Move(src^, dest^, FValueSize);
end;

procedure TOrderedList.Clear;
var
  i: Integer;
  item: Pointer;
begin
  item := FItems;
  for i := 0 to FSize - 1 do
  begin
    CleanupKey(item);
    if (FValueSize > 0) then
      CleanupValue(Pointer(TPointerType(item) + FKeySize));
    Inc(PAnsiChar(item), ItemSize);
  end;

  if (FItems <> nil) then
  begin
    System.FreeMemory(FItems);
    FItems := nil;
  end;
  FSize := 0;
  FCapacity := 0;
end;

function TOrderedList.CompareKey(key1, key2: Pointer): TCompareResult;
begin
  Result := TCompareResult(CompareMemory(key1, key2, FKeySize));
end;

procedure TOrderedList.Copy(const src: IDictionary);
var
  iterator: IDictionaryIterator;
begin
  (* key size not equal, can not do copy *)
  if ((src.KeySize <> FKeySize) or
    (src.ValueSize <> FValueSize)) then Exit;
  
  iterator := src.Iterator as IDictionaryIterator;
  while (not iterator.Eof) do
  begin
    Self.Dictionary_Insert(iterator._Key, iterator._Value, nil, False);
    iterator.next;
  end;
end;

constructor TOrderedList.Create(_keySize, _valueSize: Integer);
begin
  inherited Create;
  FKeySize := _keySize;
  FValueSize := _valueSize;
  ItemSize := _keySize + _valueSize;
end;

destructor TOrderedList.Destroy;
begin
  Clear;
  inherited;
end;

function TOrderedList.Dictionary_GetItem(key: Pointer): Pointer;
var
  index: Integer;
begin
  index := _IndexOf(key);
  if (index >= 0) then Result := _GetValue(index)
  else Result := nil;
end;

function TOrderedList.Dictionary_Insert(key, value: Pointer;
  internal: PPointer; replaceIfExists: Boolean): Boolean;
var
  index: Integer;
begin
  index := List_Insert(key, value);
  if (internal <> nil) then internal^ := Pointer(index);
  Result := index >= 0;
end;

procedure TOrderedList.Dictionary_SetItem(key, value: Pointer);
var
  index: Integer;
begin
  index := _IndexOf(key);
  if (index >= 0) then _SetValue(index, value)
  else List_Insert(key, value);
end;

procedure TOrderedList.List_Erase(index: Integer);
var
  item: Pointer;
begin
  if ((index >= 0) and (index < FSize)) then
  begin
    item := Pointer(TPointerType(FItems) + index * ItemSize);
    CleanupKey(item);
    if (FValueSize > 0) then
      CleanupValue(Pointer(TPointerType(item) + FKeySize));
    if (index < FSize - 1) then
    begin
      (* batch move *)
      Move(Pointer(TPointerType(item) + ItemSize)^,
        item^, ItemSize * (FSize - index - 1));
    end;
    Dec(FSize);
  end;
end;

class procedure TOrderedList.Error(Msg: PResStringRec; Data: Integer);
begin
  TOrderedList.Error(LoadResString(msg), Data);
end;

class procedure TOrderedList.Error(const Msg: string; Data: Integer);
  function ReturnAddr: Pointer;
  asm
    MOV EAX, [EBP+4]
  end;
begin
  raise EdzListError.CreateFmt(Msg, [Data]) at ReturnAddr;
end;

procedure TOrderedList.ExchangeKey(src, dest: Pointer);
begin
  ExchangeMemory(src, dest, FKeySize);
end;

procedure TOrderedList.ExchangeValue(src, dest: Pointer);
begin
  ExchangeMemory(src, dest, FValueSize);
end;

function TOrderedList.GetAllowDuplicate: Boolean;
begin
  Result := (FOption and LIST_ALLOW_DUPLICATE <> 0);
end;

function TOrderedList.GetCapacity: Int64;
begin
  Result := FCapacity;
end;

function TOrderedList.GetConflict: Int64;
begin
  Result := 0;
end;

function TOrderedList.GetFirstPair: Pointer;
begin
  Result := Pointer(0);
end;

function TOrderedList.GetKeySize: Integer;
begin
  Result := FKeySize;  
end;

function TOrderedList.GetLastPair: Pointer;
begin
  Result := Pointer(FSize - 1);
end;

function TOrderedList.GetOrdered: Boolean;
begin
  Result := (FOption and LIST_ORDERED <> 0);
end;

function TOrderedList.GetPairKey(pair: Pointer): Pointer;
begin
  Result := _GetKey(Integer(pair));
end;

function TOrderedList.GetPairValue(pair: Pointer): Pointer;
begin
  Result := _GetValue(Integer(pair));
end;

function TOrderedList.GetSize: Int64;
begin
  Result := FSize;
end;

function TOrderedList.GetValueSize: Integer;
begin
  Result := FValueSize;
end;

function TOrderedList._GetKey(index: Integer): Pointer;
begin
  Result := nil;
  if (index >= FSize) then TOrderedList.Error(@SListindexError, index)
  else
    Result := Pointer(TPointerType(FItems) + ItemSize * index);
end;

function TOrderedList._GetValue(index: Integer): Pointer;
begin
  Result := nil;
  if (index >= FSize) then
    TOrderedList.Error(@SListindexError, index)
  else
    Result := Pointer(TPointerType(FItems) + ItemSize * index + FKeySize);
end;

procedure TOrderedList.Grow;
var
  Delta: Integer;
begin
  if FCapacity > 64 then Delta := FCapacity div 4
  else if FCapacity > 8 then Delta := 16
  else Delta := 4;
  SetCapacity(FCapacity + Delta);
end;

procedure TOrderedList.InitKey(key: Pointer);
begin
  //FillChar(key^, FKeySize, 0);
end;

procedure TOrderedList.InitValue(value: Pointer);
begin
  //FillChar(value^, FValueSize, 0);
end;

function TOrderedList._Delete(pair: Pointer): Pointer;
begin
  List_Erase(Integer(pair));
  Result := pair;
end;

function TOrderedList.Dictionary_Erase(key: Pointer): Boolean;
var
  index: Integer;
begin
  index := _IndexOf(key);
  if (index >= 0) then
  begin
    List_Erase(index);
    Result := True;
  end
  else Result := False;  
end;

function TOrderedList._Find(key: Pointer; value: PPointer): Boolean;
var
  index: Integer;
begin
  index:= _IndexOf(key);
  if (index >= 0) then
  begin
    if (value <> nil) then
      value^ := Pointer(TPointerType(FItems) + index * ItemSize + FKeySize);
    Result := True;
  end
  else Result := False; 
end;

(*++
  if the list is ordered, perform binary-search,
  else perform sequential search
--*)
function TOrderedList._IndexOf(key: Pointer): Integer;
var
  L, R, M: Integer;
  cmp: TCompareResult;
  item: Pointer;
begin
  if (GetOrdered) then
  begin
    L := 0;
    R := FSize - 1;
    while (L <= R) do
    begin
      M := (L + R) shr 1;
      item := Pointer(TPointerType(FItems) + ItemSize * M);
      cmp := CompareKey(item, key);
      if (cmp = crEqual) then
      begin
        System.Dec(M);
        System.Dec(PAnsiChar(item), ItemSize);
        while ((M >= 0) and (CompareKey(item, key) = crEqual)) do
        begin
          System.Dec(M);
          System.Dec(PAnsiChar(item), ItemSize);
        end;
        Result := M + 1;
        Exit;
      end
      else if (cmp = crLess) then
      begin
        L := M + 1;
      end
      else begin
        R := M - 1;
      end;
    end;
  end
  else begin
    item := FItems;
    for M := 0 to FSize - 1 do
    begin
      if (crEqual = CompareKey(item, key)) then
      begin
        Result := M;
        Exit;
      end;
      Inc(PAnsiChar(item), ItemSize);
    end;
  end;
  Result := INDEX_NOT_EXISTS;
end;

procedure TOrderedList.QuickSort(l, r: Integer);
var
  i, j, k: Integer;
  p, p1, p2: Pointer;
begin
  repeat
    i := l;
    j := r;
    k := (l + r) shr 1;
    p := Pointer(Integer(FItems) + ItemSize * k);
    repeat
      p1 := Pointer(Integer(FItems) + ItemSize * i);
      p2 := Pointer(Integer(FItems) + ItemSize * j);
      while (CompareKey(p1, p) = crLess) do
      begin
        System.Inc(i);
        System.Inc(PAnsiChar(p1), ItemSize);
      end;
      while (CompareKey(p2, p) = crGreater) do
      begin
        System.Dec(j);
        System.Dec(PAnsiChar(p2), ItemSize);
      end;
      if (i <= j) then
      begin
        ExchangeKey(p1, p2);
        if (FValueSize > 0) then
          ExchangeValue(
            Pointer(TPointerType(p1) + FKeySize),
            Pointer(TPointerType(p2) + FKeySize));
        if (i = k) then
        begin
          k := j;
          p := Pointer(Integer(FItems) + ItemSize * k);
        end
        else if (j = k) then
        begin
          k := i;
          p := Pointer(Integer(FItems) + ItemSize * k);
        end;
        System.Inc(i);
        System.Dec(j);
      end;
    until (i > j);
    if (l < j) then QuickSort(l, j);
    l := i;
  until (i >= r);
end;

function TOrderedList.List_Insert(key, value: Pointer): Integer;
var
  Idx: Integer;
  L, R, M: Integer;
  item: Pointer;
  cmp: TCompareResult;
begin
  if (GetOrdered and (FSize > 0)) then
  begin
    //if list is ordered, perform binary-search 
    L := 0;
    R := FSize - 1;
    Idx := 0;
    while (L <= R) do
    begin
      M := (L + R) div 2;
      item := Pointer(Integer(FItems) + ItemSize * M);
      cmp := CompareKey(item, value);
      if (cmp = crEqual) then
      begin
        if (not GetAllowDuplicate) then
        begin
          Result := -1;
          Exit;
        end;
        System.Inc(M);
        System.Inc(PAnsiChar(item), ItemSize);
        while ((M < FSize) and (CompareKey(item, value) = crEqual)) do
        begin
          System.Inc(M);
          System.Inc(PAnsiChar(item), ItemSize);
        end;
        Idx := M;
      end
      else if (cmp = crLess) then
      begin
        if ((M = FSize - 1) or (CompareKey(Pointer(Integer(item) +
          ItemSize), value) = crGreater)) then
        begin
          Idx := M + 1;
          Break;
        end
        else L := M + 1;
      end
      else begin
        if ((M = 0) or (CompareKey(Pointer(Integer(item) -
          ItemSize), value) = crLess)) then
        begin
          Idx := M;
          Break;
        end
        else R := M - 1;
      end;
    end;
  end
  else Idx := FSize;

  _InsertAt(Idx, key, value);
  Result := Idx;
end;

procedure TOrderedList._InsertAt(index: Integer; key, value: Pointer);
var
  item: Pointer;
begin
  if (FSize = FCapacity) then Grow;
  item := Pointer(TPointerType(FItems) + ItemSize * index);
  if (FSize > index) then
    Move(item^, Pointer(TPointerType(item) + ItemSize)^, ItemSize * (FSize - index));
  AssignKey(key, item);
  Inc(PAnsiChar(item), FKeySize);
  if (FValueSize > 0) then AssignValue(value, item);
  Inc(FSize);
end;

procedure TOrderedList._SetKey(index: Integer; key: Pointer);
var
  prev ,current, next: Pointer;
begin
  if (index >= FSize) then
    TOrderedList.Error(@SListindexError, index)
  else  begin
    current := Pointer(Integer(FItems) + index * ItemSize);
    if (GetOrdered) then
    begin
      if (index > 0) then
      begin
        prev := Pointer(TPointerType(current) - ItemSize);
        if (CompareKey(prev, key) = crGreater) then
          TOrderedList.Error(SListOperationError, index);
      end
      else if (index < FSize - 1) then
      begin
        next := Pointer(Integer(current) + ItemSize);
        if (CompareKey(next, key) = crLess) then
          TOrderedList.Error(SListOperationError, index);
      end;
    end;
    AssignKey(key, current);
  end;
end;

procedure TOrderedList._SetValue(index: Integer; value: Pointer);
begin
  if (index >= FSize) then
    TOrderedList.Error(@SListindexError, index)
  else
    AssignValue(value, Pointer(Integer(FItems) +
      index * ItemSize + FKeySize));
end;

procedure TOrderedList.SetAllowDuplicate(value: Boolean);
begin
  if (value) then FOption := FOption or LIST_ALLOW_DUPLICATE
  else FOption := FOption and not LIST_ALLOW_DUPLICATE;
end;

procedure TOrderedList.SetCapacity(const Value: Int64);
var
  cur: Pointer;
  i: Integer;
begin
  if (Value < FSize) or (Value > $7fffffff div ItemSize) then Exit;
  if (Value <> FCapacity) then
  begin
    if (FItems = nil) then FItems := System.GetMemory(Value * ItemSize)
    else FItems := System.ReallocMemory(FItems, Value * ItemSize);
    cur := Pointer(TPointerType(FItems) + ItemSize * FSize);
    for i := 0 to Value - FCapacity - 1 do
    begin
      InitKey(cur);
      Inc(PAnsiChar(cur), FKeySize);
      InitValue(cur);
      Inc(PAnsiChar(cur), FValueSize);
    end;
    FCapacity := Value;
  end;
end;

procedure TOrderedList.CleanupKey(item: Pointer);
begin
  
end;

procedure TOrderedList.CleanupValue(value: Pointer);
begin

end;

procedure TOrderedList.SetOrdered(value: Boolean);
begin
  if (GetOrdered <> value) then
  begin
    if (value) then FOption := FOption or LIST_ORDERED
    else FOption := FOption and not LIST_ORDERED;
    if (value and (FSize > 0)) then QuickSort(0, FSize - 1);
  end;
end;

procedure TOrderedList.SetPairValue(pair, value: Pointer);
begin
  _SetValue(Integer(pair), value);
end;

procedure TOrderedList.SetSize(const Value: Int64);
var
  i: Integer;
  cur: Pointer;
begin
  if (value > $7fffffff div ItemSize) then
    TOrderedList.Error(@SListCountError, value);
  if (value > FCapacity) then SetCapacity(value);
  if (value < FSize) then
  begin
    cur := Pointer(TPointerType(FItems) + ItemSize * (FSize - 1));
    for i := 0 to FSize - value - 1 do
    begin
      CleanupKey(cur);
      if (FValueSize > 0) then
        CleanupValue(Pointer(TPointerType(cur) + FKeySize));
      Dec(PAnsiChar(cur), ItemSize);
    end;
  end;
  FSize := value;
end;

function TOrderedList.Succeed(pair: Pointer): Pointer;
begin
  if (Integer(pair) < FSize) then
    Result := Pointer(Integer(pair) + 1)
  else Result := pair;
end;

procedure TOrderedList.List_SetItem(index: Integer; key, value: Pointer);
var
  prev ,current, next: Pointer;
begin
  if (index >= FSize) then
    TOrderedList.Error(@SListindexError, index)
  else  begin
    current := Pointer(Integer(FItems) + index * ItemSize);
    if (GetOrdered) then
    begin
      if (index > 0) then
      begin
        prev := Pointer(TPointerType(current) - ItemSize);
        if (CompareKey(prev, key) = crGreater) then
          TOrderedList.Error(SListOperationError, index);
      end
      else if (index < FSize - 1) then
      begin
        next := Pointer(Integer(current) + ItemSize);
        if (CompareKey(next, key) = crLess) then
          TOrderedList.Error(SListOperationError, index);
      end;
    end;
    AssignKey(key, current);
    if (FValueSize > 0) then
      AssignValue(value, Pointer(Integer(current) + FKeySize));
  end;
end;

function TOrderedList.Precede(pair: Pointer): Pointer;
begin
  if (Integer(pair) > 0) then
    Result := Pointer(Integer(pair) - 1)
  else Result := pair;
end;

{ TOrderedPointerList }

procedure TOrderedPointerList.AssignKey(src, dest: Pointer);
begin
  PPointer(dest)^ := PPointer(src)^;
end;

function TOrderedPointerList.CompareKey(key1, key2: Pointer): TCompareResult;
begin
  Result := FCompare(PPointer(key1)^, PPointer(key2)^);
end;

constructor TOrderedPointerList.Create(_compare: TComparePointerProc);
begin
  inherited Create(SizeOf(Pointer), 0);
  FCompare := _compare;
end;

function TOrderedPointerList.GetItem(index: Integer): Pointer;
begin
  Result := PPointer(_GetKey(index))^;
end;

function TOrderedPointerList.GetIterator: IIterator;
begin
  Result := TPointerListIterator.Create(Self);
  Result.First;
end;

function TOrderedPointerList.IndexOf(item: Pointer): Integer;
begin
  Result := _IndexOf(@item);
end;

procedure TOrderedPointerList.InsertAt(index: Integer; item: Pointer);
begin
  if (GetOrdered) then List_Insert(@item, nil)
  else _InsertAt(index, @item, nil);
end;

procedure TOrderedPointerList.ExchangeKey(key1, key2: Pointer);
var
  p: Pointer;
begin
  p := PPointer(key1)^;
  PPointer(key1)^ := PPointer(key2)^;
  PPointer(key2)^ := p;
end;

function TOrderedPointerList.PopBack: Pointer;
var
  last: Integer;
begin
  last := GetSize - 1;
  Result := PPointer(_GetKey(last))^;
  List_Erase(last);
end;

function TOrderedPointerList.PopFront: Pointer;
begin
  Result := PPointer(_GetKey(0))^;
  List_Erase(0);
end;

procedure TOrderedPointerList.PushBack(item: Pointer);
begin
  List_Insert(@item, nil);
end;

procedure TOrderedPointerList.PushFront(item: Pointer);
begin
  InsertAt(0, item);
end;

procedure TOrderedPointerList.SetItem(index: Integer; item: Pointer);
begin
  _SetKey(index, @item);
end;

{ TAnsiStringList }

constructor TAnsiStringList.Create;
begin
  inherited Create(SizeOf(AnsiString), 0);
  FObjectStored := False;
end;

function TAnsiStringList.CompareKey(key1, key2: Pointer): TCompareResult;
var
  options: TStringCompareOptions;
begin
  if (FCaseSensitive) then options := []
  else options := [coIgnoreCase];
  Result := AnsiCompareString(PAnsiString(key1)^, PAnsiString(key2)^, options);
end;

constructor TAnsiStringList.Create(_storeObject: Boolean);
begin
  FObjectStored := _storeObject;
  inherited Create(SizeOf(AnsiString), Ord(_storeObject) * SizeOf(TObject));
end;

function TAnsiStringList.GetCaseSensitive: Boolean;
begin
  Result := FCaseSensitive;
end;

function TAnsiStringList.AnsiStrDictionary_GetItem(const key: AnsiString): Pointer;
var
  index: Integer;
begin
  index := _IndexOf(@key);
  if (index = INDEX_NOT_EXISTS) then Result := nil
  else Result := PPointer(_GetValue(index))^;
end;

procedure TAnsiStringList.AnsiStrDictionary_SetItem(const key: AnsiString; value: Pointer);
var
  index: Integer;
begin
  index := _IndexOf(@key);
  if (index <> INDEX_NOT_EXISTS) then _SetValue(index, @value);
end;

function TAnsiStringList.AnsiStringList_GetItem(index: Integer): AnsiString;
begin
  Result := PAnsiString(_GetKey(index))^;
end;

function TAnsiStringList.GetIterator: IIterator;
begin
  Result := TAnsiStringListIterator.Create(Self);
  Result.First;
end;

function TAnsiStringList.GetObjectByIndex(index: Integer): Pointer;
begin
  Assert(FObjectStored);
  Result := PPointer(_GetValue(index))^;
end;

function TAnsiStringList.GetObjectOfStr(str: AnsiString): Pointer;
var
  index : Integer;
begin
  Assert(FObjectStored);
  index := _IndexOf(@str);
  if ((index >= 0) and (index < FSize)) then Result := PPointer(_GetValue(index))^
  else Result := nil;
end;

function TAnsiStringList.IndexOf(item: AnsiString): Integer;
begin
  Result := _IndexOf(@item);
end;

procedure TAnsiStringList.InitKey(key: Pointer);
begin
  PPointer(key)^ := nil;
end;

function TAnsiStringList.Insert(const key: AnsiString; value: Pointer;
  internal: PPointer; replaceIfExists: Boolean): Boolean;
var
  index: Integer;
begin
  index := List_Insert(@key, @value);
  if (internal <> nil) then internal^ := Pointer(index);
  Result := index >= 0;
end;

procedure TAnsiStringList.InsertAt(index: Integer; value: AnsiString);
begin
  if (GetOrdered) then List_Insert(@value, nil)
  else _InsertAt(index, @value, nil);
end;

procedure TAnsiStringList.InsertObjectAt(index: Integer;
  str: AnsiString; obj: Pointer);
begin
  if (GetOrdered) then List_Insert(@str, @obj)
  else _InsertAt(index, @str, @obj);
end;

function TAnsiStringList.PopBack: AnsiString;
var
  last: Integer;
begin
  last := GetSize - 1;
  Result := PAnsiString(_GetKey(last))^;
  List_Erase(last);
end;

function TAnsiStringList.PopFront: AnsiString;
begin
  Result := PAnsiString(_GetKey(0))^;
  List_Erase(0);
end;

function TAnsiStringList.PopObjectBack: Pointer;
var
  last: Integer;
begin
  last := GetSize - 1;
  Result := GetObjectByIndex(last);
  List_Erase(last);
end;

function TAnsiStringList.PopObjectFront: Pointer;
begin
  Result := GetObjectByIndex(0);
  List_Erase(0);
end;

procedure TAnsiStringList.PushBack(value: AnsiString);
begin
  List_Insert(@value, nil);
end;

procedure TAnsiStringList.PushFront(value: AnsiString);
begin
  if (GetOrdered) then List_Insert(@value, nil)
  else _InsertAt(0, @value, nil);
end;

procedure TAnsiStringList.PushObjectBack(str: AnsiString; obj: Pointer);
begin
  List_Insert(@str, @obj);
end;

procedure TAnsiStringList.PushObjectFront(str: AnsiString; obj: Pointer);
begin
  InsertObjectAt(0, str, obj);
end;

procedure TAnsiStringList.SetCaseSensitive(value: Boolean);
begin
  FCaseSensitive := Value;
end;

procedure TAnsiStringList.AnsiStringList_SetItem(index: Integer; str: AnsiString);
begin
  _SetKey(index, @str);
end;

procedure TAnsiStringList.SetObjectByIndex(index: Integer; obj: Pointer);
begin
  PPointer(_GetValue(index))^ := Pointer(obj);
end;

procedure TAnsiStringList.SetObjectOfStr(str: AnsiString; obj: Pointer);
var
  index : Integer;
begin
  index := _IndexOf(@str);
  _SetValue(index, @obj);
end;

procedure TAnsiStringList.AssignKey(src, dest: Pointer);
begin
  PAnsiString(dest)^ := PAnsiString(src)^;
end;

procedure TAnsiStringList.AssignValue(src, dest: Pointer);
begin
  PPointer(dest)^ := PPointer(src)^;
end;

procedure TAnsiStringList.CleanupKey(key: Pointer);
begin
  PAnsiString(key)^ := '';
end;

function TAnsiStringList.Erase(const key: AnsiString): Boolean;
begin
  Result := Dictionary_Erase(@key);
end;

procedure TAnsiStringList.ExchangeKey(src, dest: Pointer);
var
  p: Pointer;
begin
  p := PPointer(src)^;
  PPointer(src)^ := PPointer(dest)^;
  PPointer(dest)^ := p;
end;

procedure TAnsiStringList.ExchangeValue(src, dest: Pointer);
var
  p: Pointer;
begin
  p := PPointer(src)^;
  PPointer(src)^ := PPointer(dest)^;
  PPointer(dest)^ := p;
end;

function TAnsiStringList.Find(const key: AnsiString;value: PPointer): Boolean;
var
  valuePtr: PPointer;  
begin
  if (_Find(@key, @valuePtr)) then
  begin
    if (value <> nil) then value^ := valuePtr^;
    Result := True;
  end
  else Result := False;
end;

function TAnsiStringList.Find2(key: PAnsiChar; len: Integer; data: PPointer): Boolean;
begin
  Result := False;
end;

{ TAnsiStringListIterator }

function TAnsiStringListIterator.GetKey: AnsiString;
begin
  Result := (FList as IAnsiStringList).Item[FIndex];
end;

function TAnsiStringListIterator.GetValue: Pointer;
begin
  Result := (FList as IAnsiStringList).ObjectByIndex[FIndex];
end;

procedure TAnsiStringListIterator.SetKey(key: AnsiString);
begin
  (FList as IAnsiStringList).Item[FIndex] := key;
end;

procedure TAnsiStringListIterator.SetValue(value: Pointer);
begin
  (FList as IAnsiStringList).ObjectByIndex[FIndex] := value;
end;

function TAnsiStringListIterator._GetKey: Pointer;
begin
  Result := nil;
end;

function TAnsiStringListIterator._GetValue: Pointer;
begin
  Result := nil;
end;

procedure TAnsiStringListIterator._SetValue(value: Pointer);
begin

end;

{ TWideStringList }

constructor TWideStringList.Create;
begin
  inherited Create(SizeOf(WideString), 0);
  FObjectStored := False;
end;

function TWideStringList.CompareKey(key1, key2: Pointer): TCompareResult;
var
  options: TStringCompareOptions;
begin
  if (FCaseSensitive) then options := []
  else options := [coIgnoreCase];
  Result := WideCompareString(PWideString(key1)^, PWideString(key2)^, options);
end;

constructor TWideStringList.Create(_storeObject: Boolean);
begin
  FObjectStored := _storeObject;
  inherited Create(SizeOf(WideString),Ord(_storeObject) * SizeOf(TObject));
end;

function TWideStringList.GetCaseSensitive: Boolean;
begin
  Result := FCaseSensitive;
end;

function TWideStringList.WideStrDictionary_GetItem(const key: WideString): Pointer;
var
  index: Integer;
begin
  index := _IndexOf(@key);
  if (index = INDEX_NOT_EXISTS) then Result := nil
  else Result := PPointer(_GetValue(index))^;
end;

procedure TWideStringList.WideStrDictionary_SetItem(
  const key: WideString; value: Pointer);
var
  index: Integer;
begin
  index := _IndexOf(@key);
  if (index <> INDEX_NOT_EXISTS) then _SetValue(index, @value);
end;

function TWideStringList.WideStringList_GetItem(index: Integer): WideString;
begin
  Result := PWideString(_GetKey(index))^;
end;

function TWideStringList.GetIterator: IIterator;
begin
  Result := TWideStringListIterator.Create(Self);
  Result.First;
end;

function TWideStringList.GetObjectByIndex(index: Integer): Pointer;
begin
  Assert(FObjectStored);
  Result := PPointer(_GetValue(index))^;
end;

function TWideStringList.GetObjectOfStr(str: WideString): Pointer;
var
  index : Integer;
begin
  Assert(FObjectStored);
  index := _IndexOf(@str);
  if ((index >= 0) and (index < FSize)) then
    Result := PPointer(_GetValue(index))^
  else Result := nil;
end;

function TWideStringList.IndexOf(item: WideString): Integer;
begin
  Result := _IndexOf(@item);
end;

procedure TWideStringList.InitKey(key: Pointer);
begin
  PPointer(key)^ := nil;
end;

function TWideStringList.Insert(const key: WideString; value: Pointer;
  internal: PPointer; replaceIfExists: Boolean): Boolean;
var
  index: Integer;
begin
  index := List_Insert(@key, @value);
  if (internal <> nil) then internal^ := Pointer(index);
  Result := index >= 0;
end;

procedure TWideStringList.InsertAt(index: Integer; value: WideString);
begin
  if (GetOrdered) then List_Insert(@value, nil)
  else _InsertAt(index, @value, nil);
end;

procedure TWideStringList.InsertObjectAt(index: Integer;
  str: WideString; obj: Pointer);
begin
  if (GetOrdered) then List_Insert(@str, @obj)
  else _InsertAt(index, @str, @obj);
end;

function TWideStringList.PopBack: WideString;
var
  last: Integer;
begin
  last := GetSize - 1;
  Result := PWideString(_GetKey(last))^;
  List_Erase(last);
end;

function TWideStringList.PopFront: WideString;
begin
  Result := PWideString(_GetKey(0))^;
  List_Erase(0);
end;

function TWideStringList.PopObjectBack: Pointer;
var
  last: Integer;
begin
  last := GetSize - 1;
  Result := GetObjectByIndex(last);
  List_Erase(last);
end;

function TWideStringList.PopObjectFront: Pointer;
begin
  Result := GetObjectByIndex(0);
  List_Erase(0);
end;

procedure TWideStringList.PushBack(value: WideString);
begin
  List_Insert(@value, nil);
end;

procedure TWideStringList.PushFront(value: WideString);
begin
  if (GetOrdered) then List_Insert(@value, nil)
  else _InsertAt(0, @value, nil);
end;

procedure TWideStringList.PushObjectBack(str: WideString; obj: Pointer);
begin
  List_Insert(@str, @obj);
end;

procedure TWideStringList.PushObjectFront(str: WideString; obj: Pointer);
begin
  InsertObjectAt(0, str, obj);
end;

procedure TWideStringList.SetCaseSensitive(value: Boolean);
begin
  FCaseSensitive := Value;
end;

procedure TWideStringList.WideStringList_SetItem(index: Integer; str: WideString);
begin
  _SetKey(index, @str);
end;

procedure TWideStringList.SetObjectByIndex(index: Integer; obj: Pointer);
begin
  PPointer(_GetValue(index))^ := Pointer(obj);
end;

procedure TWideStringList.SetObjectOfStr(str: WideString; obj: Pointer);
var
  index : Integer;
begin
  index := _IndexOf(@str);
  _SetValue(index, @obj);
end;

procedure TWideStringList.AssignKey(src, dest: Pointer);
begin
  PWideString(dest)^ := PWideString(src)^;
end;

procedure TWideStringList.AssignValue(src, dest: Pointer);
begin
  PPointer(dest)^ := PPointer(src)^;
end;

procedure TWideStringList.CleanupKey(key: Pointer);
begin
  PWideString(key)^ := '';
end;

function TWideStringList.Erase(const key: WideString): Boolean;
begin
  Result := Dictionary_Erase(@key);
end;

procedure TWideStringList.ExchangeKey(src, dest: Pointer);
var
  p: Pointer;
begin
  p := PPointer(src)^;
  PPointer(src)^ := PPointer(dest)^;
  PPointer(dest)^ := p;
end;

procedure TWideStringList.ExchangeValue(src, dest: Pointer);
var
  p: Pointer;
begin
  p := PPointer(src)^;
  PPointer(src)^ := PPointer(dest)^;
  PPointer(dest)^ := p;
end;

function TWideStringList.Find(const key: WideString; value: PPointer): Boolean;
var
  valuePtr: PPointer;  
begin
  if (_Find(@key, @valuePtr)) then
  begin
    if (value <> nil) then value^ := valuePtr^;
    Result := True;
  end
  else Result := False;
end;

function TWideStringList.Find2(key: PWideChar; len: Integer; data: PPointer): Boolean;
begin
  Result := False;
end;

{ TWideStringListIterator }

function TWideStringListIterator.GetKey: WideString;
begin
  Result := (FList as IWideStringList).Item[FIndex];
end;

function TWideStringListIterator.GetValue: Pointer;
begin
  Result := (FList as IWideStringList).ObjectByIndex[FIndex];
end;

procedure TWideStringListIterator.SetKey(key: WideString);
begin
  (FList as IWideStringList).Item[FIndex] := key;
end;

procedure TWideStringListIterator.SetValue(value: Pointer);
begin
  (FList as IWideStringList).ObjectByIndex[FIndex] := value;
end;

function TWideStringListIterator._GetKey: Pointer;
begin
  Result := nil;
end;

function TWideStringListIterator._GetValue: Pointer;
begin
  Result := nil;
end;

procedure TWideStringListIterator._SetValue(value: Pointer);
begin

end;

end.
